home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / flapflag / flapflag.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-06-25  |  8.3 KB  |  232 lines
  1. VERSION 5.00
  2. Begin VB.UserControl FlappingFlag 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   1995
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   2325
  8.    ScaleHeight     =   133
  9.    ScaleMode       =   3  'Pixel
  10.    ScaleWidth      =   155
  11.    ToolboxBitmap   =   "FlapFlag.ctx":0000
  12.    Begin VB.Timer FlapTimer 
  13.       Enabled         =   0   'False
  14.       Interval        =   100
  15.       Left            =   360
  16.       Top             =   1440
  17.    End
  18.    Begin VB.PictureBox FlapPict 
  19.       AutoRedraw      =   -1  'True
  20.       AutoSize        =   -1  'True
  21.       BorderStyle     =   0  'None
  22.       Height          =   615
  23.       Index           =   0
  24.       Left            =   1080
  25.       ScaleHeight     =   41
  26.       ScaleMode       =   3  'Pixel
  27.       ScaleWidth      =   41
  28.       TabIndex        =   1
  29.       Top             =   240
  30.       Visible         =   0   'False
  31.       Width           =   615
  32.    End
  33.    Begin VB.PictureBox OrigPict 
  34.       AutoRedraw      =   -1  'True
  35.       AutoSize        =   -1  'True
  36.       BorderStyle     =   0  'None
  37.       Height          =   615
  38.       Left            =   240
  39.       ScaleHeight     =   41
  40.       ScaleMode       =   3  'Pixel
  41.       ScaleWidth      =   41
  42.       TabIndex        =   0
  43.       Top             =   240
  44.       Visible         =   0   'False
  45.       Width           =   615
  46.    End
  47. Attribute VB_Name = "FlappingFlag"
  48. Attribute VB_GlobalNameSpace = False
  49. Attribute VB_Creatable = True
  50. Attribute VB_PredeclaredId = False
  51. Attribute VB_Exposed = True
  52. Attribute VB_Description = "CCC Flapping flag control"
  53. Option Explicit
  54. 'Event Declarations:
  55. Event DblClick()
  56. Attribute DblClick.VB_Description = "Occurs when the user double clicks on the flag."
  57. Event Click()
  58. Attribute Click.VB_Description = "Occurs when the user clicks on the flag."
  59. Const MaxFlaps = 5
  60. 'Default Property Values:
  61. Const m_def_Magnitude = 2
  62. 'Property Variables:
  63. Dim m_Magnitude As Single
  64. Dim FlagWid As Single
  65. Dim FlagHgt As Single
  66. Dim Showing As Integer
  67. ' *********************************************
  68. ' Show the About dialog.
  69. ' *********************************************
  70. Public Sub ShowAbout()
  71. Attribute ShowAbout.VB_Description = "Displays the About dialog."
  72. Attribute ShowAbout.VB_UserMemId = -552
  73. Dim frm As New AboutDialog
  74.     frm.Show vbModal
  75.     Set frm = Nothing
  76. End Sub
  77. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  78. 'MappingInfo=UserControl,UserControl,-1,BackColor
  79. Public Property Get BackColor() As OLE_COLOR
  80. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  81.     BackColor = UserControl.BackColor
  82. End Property
  83. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  84.     UserControl.BackColor() = New_BackColor
  85.     PropertyChanged "BackColor"
  86. End Property
  87. ' *********************************************
  88. ' Create the flapping pictures.
  89. ' *********************************************
  90. Private Sub MakePictures()
  91. Const PI = 3.14159265
  92. Dim i As Integer
  93. Dim offset As Single
  94. Dim Doffset As Single
  95. Dim Yoffset As Single
  96. Dim Yoffset1 As Single
  97. Dim X As Single
  98. Dim dx As Single
  99.     FlagWid = OrigPict.Width
  100.     FlagHgt = OrigPict.Height + 4 * (m_Magnitude)
  101.     UserControl_Resize
  102.     ' Make all the pictures the same.
  103.     For i = 0 To MaxFlaps
  104.         Set FlapPict(i).Picture = OrigPict.Picture
  105.         FlapPict(i).Height = FlagHgt
  106.         FlapPict(i).Line (0, 0)-(FlagWid, FlagHgt), _
  107.             UserControl.BackColor, BF
  108.     Next i
  109.     offset = 0
  110.     Doffset = 2 * PI / (MaxFlaps + 1)
  111.     dx = FlagWid / (2.5 * PI)
  112.     For i = 0 To MaxFlaps
  113.         Yoffset1 = m_Magnitude * Sin(offset)
  114.         For X = 0 To FlagWid - 1
  115.             Yoffset = m_Magnitude * _
  116.                 (2 + Sin(offset + X / dx))
  117.             FlapPict(i).PaintPicture _
  118.                 OrigPict.Picture, _
  119.                 X, Yoffset - Yoffset1, _
  120.                 1, FlagHgt, X, 0, 1, FlagHgt
  121.         Next X
  122.         FlapPict(i).Picture = FlapPict(i).Image
  123.         offset = offset + Doffset
  124.     Next i
  125.     Set UserControl.Picture = FlapPict(0).Picture
  126. End Sub
  127. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  128. 'MappingInfo=OrigPict,OrigPict,-1,Picture
  129. Public Property Get Picture() As Picture
  130. Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in a control."
  131.     Set Picture = OrigPict.Picture
  132. End Property
  133. Public Property Set Picture(ByVal New_Picture As Picture)
  134.     Set OrigPict.Picture = New_Picture
  135.     ' Make the flapping pictures.
  136.     MakePictures
  137.     PropertyChanged "Picture"
  138. End Property
  139. Private Sub FlapTimer_Timer()
  140.     Showing = (Showing + 1) Mod (MaxFlaps + 1)
  141.     Set UserControl.Picture = _
  142.         FlapPict(Showing).Picture
  143. End Sub
  144. Private Sub UserControl_Click()
  145.     RaiseEvent Click
  146. End Sub
  147. Private Sub UserControl_DblClick()
  148.     RaiseEvent DblClick
  149. End Sub
  150. Private Sub UserControl_InitProperties()
  151. Dim i As Integer
  152.     For i = 1 To MaxFlaps
  153.         Load FlapPict(i)
  154.     Next i
  155.     m_Magnitude = m_def_Magnitude
  156.     FlagWid = 60
  157.     FlagHgt = 100
  158. End Sub
  159. 'Load property values from storage
  160. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  161. Dim i As Integer
  162.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  163.     Set OrigPict.Picture = PropBag.ReadProperty("OriginalPicture", Nothing)
  164.     Set UserControl.Picture = PropBag.ReadProperty("Picture", Nothing)
  165.     For i = 1 To MaxFlaps
  166.         Load FlapPict(i)
  167.     Next i
  168.     For i = 0 To MaxFlaps
  169.         Set FlapPict(i).Picture = PropBag.ReadProperty("FlapPicture" & Format$(i), Nothing)
  170.     Next i
  171.     UserControl.Enabled = PropBag.ReadProperty("Enabled", False)
  172.     If Ambient.UserMode Then _
  173.         FlapTimer.Enabled = UserControl.Enabled
  174.     m_Magnitude = PropBag.ReadProperty("Magnitude", m_def_Magnitude)
  175.     FlagWid = FlapPict(0).Width
  176.     FlagHgt = FlapPict(0).Height
  177.     Randomize
  178.     Showing = Int((MaxFlaps + 1) * Rnd)
  179. End Sub
  180. Private Sub UserControl_Resize()
  181. Static resizing As Boolean
  182.     ' Do not recurse.
  183.     If resizing Then Exit Sub
  184.     resizing = True
  185.     Size ScaleX(FlagWid, vbPixels, vbTwips), _
  186.          ScaleY(FlagHgt, vbPixels, vbTwips)
  187.     resizing = False
  188. End Sub
  189. 'Write property values to storage
  190. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  191. Dim i As Integer
  192.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  193.     Call PropBag.WriteProperty("OriginalPicture", OrigPict.Picture, Nothing)
  194.     Call PropBag.WriteProperty("Picture", UserControl.Picture, Nothing)
  195.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, False)
  196.     For i = 0 To MaxFlaps
  197.         Call PropBag.WriteProperty("FlapPicture" & Format$(i), FlapPict(i).Picture, Nothing)
  198.     Next i
  199.     Call PropBag.WriteProperty("Magnitude", m_Magnitude, m_def_Magnitude)
  200. End Sub
  201. Public Property Get FlappedImage() As Picture
  202. Attribute FlappedImage.VB_Description = "The flapped picture."
  203. Attribute FlappedImage.VB_MemberFlags = "400"
  204.     Set FlappedImage = UserControl.Picture
  205. End Property
  206. Public Property Set FlappedImage(ByVal New_FlappedImage As Picture)
  207.     If Ambient.UserMode = False Then Err.Raise 383
  208.     If Ambient.UserMode Then Err.Raise 382
  209.     Set UserControl.Picture = New_FlappedImage
  210.     PropertyChanged "FlappedImage"
  211. End Property
  212. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  213. 'MappingInfo=UserControl,UserControl,-1,Enabled
  214. Public Property Get Enabled() As Boolean
  215. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  216.     Enabled = UserControl.Enabled
  217. End Property
  218. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  219.     UserControl.Enabled() = New_Enabled
  220.     If Ambient.UserMode Then _
  221.         FlapTimer.Enabled = New_Enabled
  222.     PropertyChanged "Enabled"
  223. End Property
  224. Public Property Get Magnitude() As Single
  225. Attribute Magnitude.VB_Description = "The amount by which the flag is displaced vertically."
  226.     Magnitude = m_Magnitude
  227. End Property
  228. Public Property Let Magnitude(ByVal New_Magnitude As Single)
  229.     m_Magnitude = New_Magnitude
  230.     PropertyChanged "Magnitude"
  231. End Property
  232.